home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / TECHNICA / AUTOCAD / 3078B.ZIP / PGRUN991.ZIP / HEXBOLT.LSP < prev    next >
Lisp/Scheme  |  1991-05-20  |  10KB  |  350 lines
  1.  
  2. ; *******  ParaDraft Application  ********
  3. ; Parametric Geomtry Program generated by PgPg! 
  4. ; Authored by   : User
  5. ; Application name : Hexagonal head bolt
  6. ; Dated         : Monday , 20-5-1991
  7. ; Started at    :  --  14:58:30
  8. ; Finished at   :  --  15:00:06
  9. ; ****************************************
  10. (princ "\nParaDraft application generated on Monday , 20-5-1991 with Professional Version 1.0P")
  11. (mode 0)(command "VSLIDE"(strcat *pgpg-dir* *pg-name*))
  12. (setq dia14 nil rad5 nil rad6 nil rad7 nil ang10 nil ang11 nil L1 nil L2 nil L3 nil L4 nil L8 nil L9 nil L12 nil L13 nil  ) 
  13. (take-value 'dia14 "dia14" 14.89022364)
  14. (take-value 'rad5 "rad5" 119.34777005)
  15. (take-value 'rad6 "rad6" 25.34592075)
  16. (take-value 'rad7 "rad7" 25.34595145)
  17. (take-value 'ang10 "ang10" 32.49750163)
  18. (take-value 'ang11 "ang11" 32.49814745)
  19. (take-value 'L1 "L1" 33.39259975)
  20. (take-value 'L2 "L2" 60.1547)
  21. (take-value 'L3 "L3" 79.12930556)
  22. (take-value 'L4 "L4" 41.4612)
  23. (take-value 'L8 "L8" 91.68790011)
  24. (take-value 'L9 "L9" 55.02420011)
  25. (take-value 'L12 "L12" 33.4209)
  26. (take-value 'L13 "L13" 16.6311995)
  27. (command "REDRAW")
  28. (initget 1)
  29. (setq refpt (getpoint "\nInsertion point :"))
  30. (setq refangle (getval "\nInsertion angle:" 0.0))
  31.  
  32. (princ "Computing points ..please wait")
  33.  
  34. (setq *en* 
  35. (init refpt))(setq *dim-layer* "dim")(setq *cen-layer* "cen")
  36. (setq err 0.0)
  37. (command "COLOR""BYLAYER")
  38. (command "DIM1""DIMASZ" 0.01 )
  39. (command "DIM1""DIMTXT" 0.01 )
  40. (setvar "CMDECHO" 0)(MAKE_LAYER "CEN" 2)(setq RAD14(/ DIA14 2.0))
  41. (setq ANG10(D2R ANG10 ))
  42. (setq ANG11(D2R ANG11 ))
  43. (setq L15 (/ L2 2.0)  )
  44. (setq L16 L15 )
  45. (setq L17 (/ L3 2.0)  )
  46. (setq L18 L17 )
  47. (setq L19 (/ L4 2.0)  )
  48. (setq L20 L19 )
  49. (setq L21 (/ L12 2.0)  )
  50. (setq L22 L21 )
  51.  
  52. (setq pt1(delta refpt 
  53.                         0.0
  54.                         0.0
  55.         ))
  56. (setq pt4(delta refpt 
  57.                         ( + (x-of pt1) L17) 
  58.                         (y-of pt1)
  59.         ))
  60. (setq pt5(delta refpt 
  61.                         ( + (x-of pt1) ( - L18 )) 
  62.                         (y-of pt1)
  63.         ))
  64. (setq pt20(polar 
  65.                          pt1 
  66.                          0.0 
  67.                         L19
  68.         ))
  69. (setq pt8(delta refpt 
  70.                         (x-of pt1)
  71.                         ( + (y-of pt1) L1) 
  72.         ))
  73. (setq pt10(polar 
  74.                          pt1 
  75.                          0.0 
  76.                         L15
  77.         ))
  78. (setq pt12(delta refpt 
  79.                         ( + (x-of pt1) L15) 
  80.                         ( + (y-of pt1) L1) 
  81.         ))
  82. (setq pt19(polar 
  83.                          pt1 
  84.                          0.0 
  85.                         ( - L16 )
  86.         ))
  87. (setq pt21(polar 
  88.                          pt1 
  89.                          0.0 
  90.                         ( - L20 )
  91.         ))
  92. (setq pt17(delta refpt 
  93.                         ( + (x-of pt1) ( - L16 )) 
  94.                         ( + (y-of pt1) L1) 
  95.         ))
  96. (setq pt23(delta refpt 
  97.                         ( + (x-of pt1) L21) 
  98.                         ( + (y-of pt1) ( - L8 )) 
  99.         ))
  100. (setq pt24(delta refpt 
  101.                         (x-of pt1)
  102.                         ( + (y-of pt1) ( - L8 )) 
  103.         ))
  104. (setq pt37(polar 
  105.                          pt1 
  106.                          0.0 
  107.                         L21
  108.         ))
  109. (setq pt29(delta refpt 
  110.                         ( + (x-of pt1) ( - L22 )) 
  111.                         ( + (y-of pt1) ( - L8 )) 
  112.         ))
  113. (setq pt38(polar 
  114.                          pt1 
  115.                          0.0 
  116.                         ( - L22 )
  117.         ))
  118. (setq pt32(delta refpt 
  119.                         (x-of pt1)
  120.                         ( + (y-of pt1) L13) 
  121.         ))
  122. (setq pt34(delta refpt 
  123.                         ( + (x-of pt1) L19) 
  124.                         ( + (y-of pt1) L13) 
  125.         ))
  126. (setq pt39(delta refpt 
  127.                         ( + (x-of pt8) rad5) 
  128.                         (y-of pt8)
  129.         ))
  130. (setq pt40(delta refpt 
  131.                         ( + (x-of pt12) rad6) 
  132.                         (y-of pt12)
  133.         ))
  134. (setq pt41(delta refpt 
  135.                         ( + (x-of pt17) rad7) 
  136.                         (y-of pt17)
  137.         ))
  138. (setq pt25(delta refpt 
  139.                         ( + (x-of pt1) L21) 
  140.                         ( + L9 (y-of pt23)) 
  141.         ))
  142. (setq pt27(delta refpt 
  143.                         ( + (x-of pt1) L19) 
  144.                         ( + L9 (y-of pt23)) 
  145.         ))
  146. (setq pt28(delta refpt 
  147.                         ( + (x-of pt1) ( - L20 )) 
  148.                         ( + L9 (y-of pt23)) 
  149.         ))
  150. (setq pt30(delta refpt 
  151.                         ( + (x-of pt1) ( - L22 )) 
  152.                         ( + L9 (y-of pt23)) 
  153.         ))
  154. (setq pt42(delta refpt 
  155.                         ( + (x-of pt32) rad14) 
  156.                         (y-of pt32)
  157.         ))
  158. (setq pt6(intersect 
  159.                         (make-arc  pt8  pt39 )
  160.                         (make-line  pt1  1.57079633 )
  161.                          '- 
  162.         ))
  163. (setq pt7(intersect 
  164.                         (make-arc  pt6  pt8 )
  165.                         (make-line  pt20  1.57079633 )
  166.                          '+ 
  167.         ))
  168. (setq pt15(intersect 
  169.                         (make-arc  pt6  pt8 )
  170.                         (make-line  pt21  1.57079633 )
  171.                          '+ 
  172.         ))
  173. (setq pt26(intersect 
  174.                         (make-line  pt1  1.57079633 )
  175.                         (make-line  pt25  0.0 )
  176.                          Nil 
  177.         ))
  178. (setq pt43(midpt 
  179.                          pt7 
  180.                          pt12 
  181.         ))
  182. (setq pt44(delta refpt 
  183.                         ( + (x-of pt7) rad6) 
  184.                         (y-of pt7)
  185.         ))
  186. (setq pt13(intersect 
  187.                         (make-arc  pt12  pt40 )
  188.                         (make-line  pt10  1.57079633 )
  189.                          '- 
  190.         ))
  191. (setq pt22(intersect 
  192.                         (make-line  pt20  1.57079633 )
  193.                         (make-line  pt23 (chg-quad (  -  1.57079633 ANG10
  194.  )) )
  195.                          Nil 
  196.         ))
  197. (setq pt45(midpt 
  198.                          pt15 
  199.                          pt17 
  200.         ))
  201. (setq pt46(delta refpt 
  202.                         ( + (x-of pt15) rad7) 
  203.                         (y-of pt15)
  204.         ))
  205. (setq pt14(intersect 
  206.                         (make-arc  pt17  pt41 )
  207.                         (make-line  pt19  1.57079633 )
  208.                          '- 
  209.         ))
  210. (setq pt31(intersect 
  211.                         (make-line  pt21  1.57079633 )
  212.                         (make-line  pt29 (chg-quad (  +  1.57079633 ANG11
  213.  )) )
  214.                          Nil 
  215.         ))
  216. (setq pt11(intersect 
  217.                         (make-arc  pt13  pt7 )
  218.                         (make-line  pt4  1.57079633 )
  219.                          '+ 
  220.         ))
  221. (setq pt16(intersect 
  222.                         (make-arc  pt14  pt15 )
  223.                         (make-line  pt5  1.57079633 )
  224.                          '+ 
  225.         ))
  226. (princ "Computed points\n")(gc)
  227. (make_layer "cen" 1)
  228. (make_layer "0" 1)
  229. (make_layer "dim" 1)
  230. (make_layer "0" 1)
  231. (command "LINE" pt4 pt1 "" )
  232. (command "LINE" pt5 pt1 "" )
  233. (command "LINE" pt11 pt4 "" )
  234. (command "LINE" pt8 pt12 "" )
  235. (command "LINE" pt8 pt17 "" )
  236. (command "LINE" pt16 pt5 "" )
  237. (command "LINE" pt7 pt20 "" )
  238. (command "LINE" pt15 pt21 "" )
  239. (command "LINE" pt20 pt22 "" )
  240. (command "LINE" pt23 pt24 "" )
  241. (command "LINE" pt22 pt23 "" )
  242. (setq ent1 (entlast))(command "LINE" pt23 pt25 "" )
  243. (setq ent2 (entlast))(command "LINE" pt26 pt27 "" )
  244. (command "LINE" pt26 pt28 "" )
  245. (command "LINE" pt29 pt30 "" )
  246. (setq ent3 (entlast))(command "LINE" pt31 pt29 "" )
  247. (setq ent4 (entlast))(command "LINE" pt29 pt24 "" )
  248. (command "LINE" pt21 pt31 "" )
  249. (command "CIRCLE" pt32  rad14)
  250. (setq ent5 (entlast))(command "ARC""C" pt6 pt7 pt8)
  251. (setq ent6 (entlast))(command "ARC""C" pt13 pt11 pt7)
  252. (setq ent7 (entlast))(command "ARC""C" pt14 pt15 pt16)
  253. (setq ent8 (entlast))(command "ARC""C" pt6 pt8 pt15)
  254.  
  255. (draw-cline  pt1 195.0771 1.57079633  ) (make-cline  pt32  rad14)
  256.  
  257. (setq *detailing* T) (init refpt)
  258. (setq L23 17.17889944 )
  259. (command "DIM1""HORIZ" pt21  pt20 (setq pt47(polar 
  260.                          pt21 
  261.                          1.57079633 
  262.                         ( - L23 )
  263.         )) "")
  264. (setq L24 53.7482 )
  265. (command "DIM1""VERT" pt20  pt23 (setq pt48(polar 
  266.                          pt20 
  267.                          0.0 
  268.                         L24
  269.         )) "")
  270.  
  271. (command "DIM1""diameter" (list ent5 (polar  pt32 0.78539816 10.0))"")
  272.  
  273. (command "DIM1""DIMASZ" 3.0 )
  274. (command "DIM1""DIMTXT" 3.0 )
  275. (command "DIM1""UPDATE"(getset) "" )
  276. ( command "CHANGE""P" "" "LAYER" *dim-layer* )
  277.  
  278.  
  279.  
  280. (rotate-it refpt refangle)
  281. (princ "\n Drawing created by a ParaDraft application")(mode 1) ( setq refpt nil 
  282.  pt1 nil 
  283.  pt2 nil 
  284.  pt3 nil 
  285.  pt4 nil 
  286.  pt5 nil 
  287.  pt6 nil 
  288.  pt7 nil 
  289.  pt8 nil 
  290.  pt9 nil 
  291.  pt10 nil 
  292.  pt11 nil 
  293.  pt12 nil 
  294.  pt13 nil 
  295.  pt14 nil 
  296.  pt15 nil 
  297.  pt16 nil 
  298.  pt17 nil 
  299.  pt18 nil 
  300.  pt19 nil 
  301.  pt20 nil 
  302.  pt21 nil 
  303.  pt22 nil 
  304.  pt23 nil 
  305.  pt24 nil 
  306.  pt25 nil 
  307.  pt26 nil 
  308.  pt27 nil 
  309.  pt28 nil 
  310.  pt29 nil 
  311.  pt30 nil 
  312.  pt31 nil 
  313.  pt32 nil 
  314.  pt33 nil 
  315.  pt34 nil 
  316.  pt35 nil 
  317.  pt36 nil 
  318.  pt37 nil 
  319.  pt38 nil 
  320.  pt39 nil 
  321.  pt40 nil 
  322.  pt41 nil 
  323.  pt42 nil 
  324.  pt43 nil 
  325.  pt44 nil 
  326.  pt45 nil 
  327.  pt46 nil 
  328.  pt47 nil 
  329.  pt48 nil 
  330.  L1 nil 
  331.  L2 nil 
  332.  L3 nil 
  333.  L4 nil 
  334.  L8 nil 
  335.  L9 nil 
  336.  L12 nil 
  337.  L13 nil 
  338.  L15 nil 
  339.  L16 nil 
  340.  L17 nil 
  341.  L18 nil 
  342.  L19 nil 
  343.  L20 nil 
  344.  L21 nil 
  345.  L22 nil 
  346.  L23 nil 
  347.  L24 nil 
  348.  ) 
  349. (gc) (princ) ; Program generated at  :  --  15:00:13
  350.